Mouse Work

Mouse report generated on 2022-08-05.

Mouse Weights

Our data is in wide format which is generally easier to view in Excel but not a good format for manipulating within R.

weights |>
  janitor::remove_empty() |> # Drops columns/rows with only NA values
  select(-`Min Weight`) |> # For this we just want the daily weights
  mutate_if(is.numeric,
            round,
            digits = 1) |>
  create_dt()

We can easily pivot the data into the long format

# Tidy and pivot into long form
cleanDF <-
  weights |>
  janitor::remove_empty() |> # Drops columns/rows with only NA values
  select(-`Min Weight`) |> # For this we just want the daily weights
  pivot_longer(cols = where(is.double),
               names_to = "Time",
               values_to = "g") |>
  mutate_at("Time", as.numeric) |>
  drop_na(g) |> # remove rows with no weigh (e.g mouse is dead or didn't weigh that day)
  janitor::clean_names() 
## value for "which" not specified, defaulting to c("rows", "cols")

The dataframe is now in a format we can use:

cleanDF |>
  mutate_if(is.numeric,
            round,
            digits = 1) |>
  create_dt()
raw_weight_plot <-
  cleanDF |>
  group_by(group, sex, time) |>
  ggplot(aes(x=time, y=g, group = mouse, colour = sex)) +
  geom_line(size = 1, alpha = 0.8)+
  labs(title = "Weight Change by mouse",
       subtitle = "<span style='color:#AD0000;'>Male</span> and <span style='color:#8B9DA1;'>Female</span> mice",
       caption = paste0("(Figure generated on ", Sys.Date(), ")")) +
  xlab("Time in days") +
  ylab("Weight (g)") +
  scale_x_continuous(breaks= pretty_breaks()) +
  facet_wrap(.~group, ncol = 2) + 
  #lab_style() +
  theme(legend.position = "none",
        plot.subtitle = element_markdown()) +
  NULL

Raw mouse weights

The first thing to do is look at the raw mouse weights and just check that the data looks good i.e. no wild weight changes that would indicate a data entry error.

raw_weight_plot

Figures will be saved to a figures folder in your working directory.

showtext::showtext_opts(dpi = 300)
ggsave(paste0(rstudioapi::getActiveProject(), "/Figures/Weight_Change_by_mouse_", Sys.Date(), ".png"), device = ragg::agg_png,  res = 300, scaling = 1)
showtext::showtext_opts(dpi = 96)

Percent change

Because all of the mice have different starting weights (especially if using male and female mice) we need to normalize what we are looking at. Here we will normalize our weights by day zero - this is the day the mice receive a bacterial challenge.

per_weight_DF <-
  cleanDF |>
  group_by(group, sex, mouse) |>
  mutate(first = g[time == 0]) |>
  mutate(pct_weight = (g / first) * 100)

per_weight_DF |>
  mutate_if(is.numeric,
            round,
            digits = 1) |>
  create_dt()
## `mutate_if()` ignored the following grouping variables:
## • Columns `group`, `sex`, `mouse`
per_weight <-
per_weight_DF |>  
  ggplot(aes(x=time, y=pct_weight, group = mouse,  colour = sex)) +
  geom_hline(yintercept = 100, linetype = 3, size = 0.6, alpha = 0.3) +
  geom_vline(xintercept = 0, linetype = 3, size = 0.6, alpha = 0.3) +
  geom_hline(yintercept = 80, linetype = 3, size = 0.6, colour = "darkred", alpha = 0.5) +
  geom_line(size=1, alpha = 0.8) +
  labs(title = "Percent Weight Change by mouse", 
      subtitle = "Normalized to day zero <span style = 'color:#AD0000;'>Male</span> and <span style = 'color:#8B9DA1;'>Female</span> mice",
      caption = paste0("(Figure generated on ", Sys.Date(), ")")) +
  xlab("Time in days") +
  ylab("Percent weight") +
  scale_y_continuous(labels = function(x) paste0(x, "%")) + # Add percent symbol to your axis labels
  scale_x_continuous(breaks= pretty_breaks()) +
  facet_wrap(group~., nrow =2) + 
  #lab_style() +
  theme(legend.position = "none",
        plot.subtitle = element_markdown()) +
  NULL
per_weight

Average weight change by group/sex

Because we want to know how our groups are effected overall we can plot the mean weights and standard deviation. First we need to calculate this and generate a new DF. We will add a mouse number column so we can clearly see if any mice have been lost due to disease.

ave_weight_DF <- 
  per_weight_DF |>
  group_by(group, time) |>
  summarise(mean_pct_weight = mean(pct_weight, na.rm = TRUE), # mean weight per group
            std_pct_weight = sd(pct_weight, na.rm = TRUE),  # SD per group
            mouse_num = sum(!is.na(pct_weight)),  # Count of number of mice at each timepoint
            .groups = "drop")
  
ave_weight_DF |>
  mutate_if(is.numeric,
            round,
            digits = 1) |>
  create_dt()

Plot the new data.

ave_weight <-
ave_weight_DF |>
  ggplot() +
  geom_hline(yintercept = 100, linetype = 3, size = 0.6, alpha = 0.3) +
  geom_vline(xintercept = 0, linetype = 3, size = 0.6, alpha = 0.3) +
  geom_ribbon(aes(x = time, ymin = mean_pct_weight - std_pct_weight, ymax = mean_pct_weight + std_pct_weight,
                  group = group), alpha = 0.15) +
  geom_line(aes(x=time, y=mean_pct_weight , group = group), size=1) +
  geom_text(aes(x=time, y=(max(mean_pct_weight) + 10), label = mouse_num, colour = "grey20")) +
  labs(title = "Mean Percent Weight Change With SD", 
       subtitle = "Weight from experiment start",
       caption = paste0("(Figure generated on ", Sys.Date(), ")")) +
  xlab("Time in days") +
  ylab("Percent weight") +
  scale_x_continuous(breaks= pretty_breaks()) +
  facet_wrap(.~group, nrow = 2) + 
  #lab_style() +
  theme(legend.position = "none") +
  NULL

ave_weight

Clinical Score

The clinical score is based upon five categories scored 0-3 with 3 being the most severe:

## Error in per_weight_DF(tabl): could not find function "per_weight_DF"
# clean up dataframe

clinical <-
  clinical |>
  janitor::clean_names() |>
  na.omit()# Drops rows with NA values
  
clinical |>
  create_dt()

As before we first clean up our DF

clin_score <- 
  clinical |>
  group_by(group, mouse, day) |>
  summarise(total_score = sum(score), .groups = "drop") |>
  ggplot(aes(x=day, y=total_score)) +
  geom_beeswarm(groupOnX=TRUE) + # from ggbeeswarm package - lays points out side by side instead of overlapping
  stat_summary(aes(y = total_score, x = day, group=1), fun=median, colour="red", geom="line", group=1) +
  scale_x_continuous(breaks= pretty_breaks()) +
  labs(title = "Clinical Score", 
       subtitle = "Points represent individual mice, line is the median score",
       caption = paste0("(Figure generated on ", Sys.Date(), ")")) +
  xlab("Time in days") +
  ylab("Clinical Score") +
  facet_wrap(.~group, nrow = 2) + 
  #lab_style() + 
  NULL

clin_score

clin_score2 <-
  clinical |>
  group_by(day) |>
  filter(sum(score, na.rm = TRUE) > 0) |> # Drop days that only contain 0 scores
  ggplot() +
  geom_bar(aes(x=day, y=score, fill=category), stat = "identity") +
  scale_y_continuous(expand = c(0, 0)) +
  facet_wrap(.~mouse) + 
  labs(title = "Clinical Score", 
       subtitle = "Individual Clinical Scores for <span style = 'color:#004E74;'>Diarrhea</span>, <span style = 'color:#8B9DA1;'>Activity</span>, <span style = 'color:#AD0000;'>Coat</span>, <span style = 'color:#00A89D;'>Posture</span>, and <span style = 'color:#FEBE10;'>Eyes & Nose</span>.<br>Only days that contain a score > 0 for at least one mouse are shown <br>(e.g. days with no disease signes are dropped)",
       caption = paste0("(Figure generated on ", Sys.Date(), ")")) +
  xlab("Time in days") +
  ylab("Clinical Scores") +
  #lab_style() +
  theme(legend.position = "none",
        plot.subtitle = element_markdown(),
        axis.text.y = element_text(size = 6),
        strip.text = element_text(size = 8)) +
  NULL

clin_score2

CFUs

We want to know how much of our bacteria are present - usually in stool but also in tissues if we expect translocation. To get normalize our readout to CFUs per gram we also need the stool weight data.

# Tidy and pivot into long form
cleanDF_cfu <- 
  cfu |>
    janitor::remove_empty() |># Drops columns/rows with only NA values
    pivot_longer(cols = where(is.double), names_to = "Time", values_to = "cfu") |>
    mutate_at("Time", as.numeric) |>
    janitor::clean_names()
## value for "which" not specified, defaulting to c("rows", "cols")
cleanDF_cfu |>
  create_dt()
# Tidy and pivot into long form
cleanDF_stool <- 
  stool |>
    janitor::remove_empty() |># Drops columns/rows with only NA values
    pivot_longer(cols = where(is.double), names_to = "Time", values_to = "stool_weight") |>
    mutate_at("Time", as.numeric) |>
    janitor::clean_names() |>
    filter(weight_mg == "Stool") |>
    select(-weight_mg)
## value for "which" not specified, defaulting to c("rows", "cols")
cleanDF_stool |>
  create_dt() 

The stool weights df cleanDF_stool is 1/3 the size of our cleanDF_cfu df but we can use full_join to correctly merge these dataframes and calculate the CFU per gram.

cleanDF_cfu_gram <-
  full_join(cleanDF_cfu, cleanDF_stool) |>
  mutate(cfu_per_gram = (cfu/stool_weight)*1000)
## Joining, by = c("group", "mouse", "time")
cleanDF_cfu_gram |>
  create_dt() |>
  formatSignif(columns = c('cfu', 'cfu_per_gram'), digits = 3)
cfu_nums <- 
  cleanDF_cfu_gram |>
  na.omit() |>
  filter(morphotype != "Total") |># look at spores and veg individualy
  ggplot() +
  geom_bar(aes(x=time, y=log10(cfu_per_gram), fill = morphotype), stat = "identity", position = "dodge") +
  facet_wrap(.~mouse) + 
  #lab_style() + 
  scale_y_continuous(expand = c(0, 0), breaks= pretty_breaks()) +
  labs(title = "Bacterial load", 
       subtitle = "CFUs per gram from <span style = 'color:#8B9DA1;'>spores</span> and <span style = 'color:#AD0000;'>vegetative</span> cells",
       caption = paste0("(Figure generated on ", Sys.Date(), ")")) +
  ylab("log10 CFUs per gram") +
  xlab("Time (days)") +
  theme(legend.position = "none",
        plot.subtitle = element_markdown(),
        axis.text.y = element_text(size = 6),
        strip.text = element_text(size = 8)
        ) +
  NULL

cfu_nums

cfu_nums2 <- 
  cleanDF_cfu_gram |>
  na.omit() |>
  filter(morphotype == "Total") |>
  ggplot(aes(x=time, y=log10(cfu_per_gram), group = group, colour = group)) +
  geom_point(position = position_dodge(width = 0.95), alpha = 0.75) +
  stat_summary(geom = "crossbar", fun = mean, 
               width = 0.8, position = position_dodge(width = 0.95)) +
  #lab_style() +
  scale_y_continuous(breaks= pretty_breaks()) +
  scale_x_continuous(breaks= pretty_breaks()) +
  labs(title = "Bacterial load",
       subtitle = "Total CFUs per gram") +
  ylab("log10 CFUs per gram") +
  xlab("Time (days)") +
  theme(panel.grid.major.y = element_line(color="#cbcbcb")) + 
  NULL

cfu_nums2

A quick and dirty stats test. This code runs an ANOVA at each timepoint. You might be better off doing a repeated measures ANOVA or mixed models. Speak to a stats guy/gal.

# Statistical test

stat.test <- 
  cleanDF_cfu_gram |>
  na.omit() |> # remove rows without data
  group_by(time) |>
  anova_test(cfu_per_gram~group) |># from rstatix package
  adjust_pvalue(method = "holm") |>
  add_significance() 

stat.test |>
  create_dt()

Mortality

Did any of the groups have mice that died or needed to be euthanised? Because survival curves can often overly on top of each other we will label each line.

exp_time <- max(surv$Time)

surv_plot <- 
  surv |>
  mutate(
    name_lab = if_else(Time == max(Time), Group, NA_character_)
  ) |>
  ggplot(aes(x=Time, y=`S(t)`, colour = Group)) +
  geom_step(size = 1.5, alpha = 0.8) +
  scale_y_continuous(breaks= pretty_breaks(), 
                     labels = scales::percent, 
                     limits = c(0,1), # set limits to 0-1 regardless of data
                     expand = expansion(mult = c(0, 0.05))) +
  scale_x_continuous(breaks= pretty_breaks(), 
                     expand = expansion(add  = c(0, 3))) + # expands x axis by 3 to make room for names
  labs(title = "Mouse Survival") +
  xlab("Time (days)") +
  ylab("") +
  geom_text_repel(
    aes(color = Group, label = name_lab),
    size = 5,
    direction = "y",
    xlim = c((exp_time+0.8), NA),
    hjust = 0,
    segment.size = .75,
    segment.alpha = .75,
    segment.linetype = "dotted",
    box.padding = .4,
    segment.curvature = -0.1,
    segment.ncp = 3,
    segment.angle = 20
  ) +
  coord_cartesian(
    clip = "off"
  ) +
  #lab_style() +
  theme(legend.position = "none") +
  NULL

surv_plot
## Warning: Removed 42 rows containing missing values (geom_text_repel).

## Warning: Removed 42 rows containing missing values (geom_text_repel).
pander(sessionInfo(), compact = FALSE)

R version 4.2.1 (2022-06-23 ucrt)

Platform: x86_64-w64-mingw32/x64 (64-bit)

locale: LC_COLLATE=English_United States.utf8, LC_CTYPE=English_United States.utf8, LC_MONETARY=English_United States.utf8, LC_NUMERIC=C and LC_TIME=English_United States.utf8

attached base packages:

  • stats
  • graphics
  • grDevices
  • utils
  • datasets
  • methods
  • base

other attached packages:

  • pander(v.0.6.5)
  • rstatix(v.0.7.0.999)
  • scales(v.1.2.0)
  • ragg(v.1.2.2)
  • DT(v.0.23)
  • ggrepel(v.0.9.1)
  • ggbeeswarm(v.0.6.0)
  • ggplot2(v.3.3.6)
  • ggtext(v.0.1.1)
  • tidyr(v.1.2.0)
  • dplyr(v.1.0.9)
  • janitor(v.2.1.0)
  • readxl(v.1.4.0)
  • pacman(v.0.5.1)
  • mouseR(v.0.1.0)

loaded via a namespace (and not attached):

  • sass(v.0.4.2)
  • jsonlite(v.1.8.0)
  • showtext(v.0.9-5)
  • carData(v.3.0-5)
  • bslib(v.0.4.0)
  • assertthat(v.0.2.1)
  • highr(v.0.9)
  • showtextdb(v.3.0)
  • vipor(v.0.4.5)
  • cellranger(v.1.1.0)
  • yaml(v.2.3.5)
  • pillar(v.1.7.0)
  • backports(v.1.4.1)
  • glue(v.1.6.2)
  • digest(v.0.6.29)
  • gridtext(v.0.1.4)
  • snakecase(v.0.11.0)
  • colorspace(v.2.0-3)
  • htmltools(v.0.5.3)
  • pkgconfig(v.2.0.3)
  • broom(v.1.0.0)
  • bookdown(v.0.27)
  • sysfonts(v.0.8.8)
  • purrr(v.0.3.4)
  • tibble(v.3.1.7)
  • generics(v.0.1.3)
  • farver(v.2.1.1)
  • car(v.3.1-0)
  • ellipsis(v.0.3.2)
  • cachem(v.1.0.6)
  • withr(v.2.5.0)
  • cli(v.3.3.0)
  • magrittr(v.2.0.3)
  • crayon(v.1.5.1)
  • evaluate(v.0.15)
  • fansi(v.1.0.3)
  • xml2(v.1.3.3)
  • beeswarm(v.0.4.0)
  • textshaping(v.0.3.6)
  • tools(v.4.2.1)
  • lifecycle(v.1.0.1)
  • stringr(v.1.4.0)
  • munsell(v.0.5.0)
  • compiler(v.4.2.1)
  • jquerylib(v.0.1.4)
  • systemfonts(v.1.0.4)
  • rlang(v.1.0.4)
  • grid(v.4.2.1)
  • rstudioapi(v.0.13)
  • htmlwidgets(v.1.5.4)
  • crosstalk(v.1.2.0)
  • labeling(v.0.4.2)
  • rmarkdown(v.2.14.3)
  • gtable(v.0.3.0)
  • abind(v.1.4-5)
  • DBI(v.1.1.3)
  • rematch(v.1.0.1)
  • markdown(v.1.1)
  • R6(v.2.5.1)
  • lubridate(v.1.8.0)
  • knitr(v.1.39)
  • fastmap(v.1.1.0)
  • utf8(v.1.2.2)
  • stringi(v.1.7.8)
  • rmdformats(v.1.0.4)
  • Rcpp(v.1.0.9)
  • vctrs(v.0.4.1)
  • tidyselect(v.1.1.2)
  • xfun(v.0.31)